#!/usr/bin/perl -wc

package RFCMail::Util::Users;

use strict;


sub new {
    my ($class, $data) = @_;
    $data = {}
	if not defined($data);
    return (bless $data, $class);
}


sub from_perl {
    my ($class, $file) = @_;
    my $data = RFCMail::Util::Users::configfile::do_file($file);
    return ($class->new($data));
}



package RFCMail::Util::Users::configfile;

use strict;


my ($Self, $Context, $Here, @Errors);


sub do_file {
    my ($file) = @_;
    ($Self, $Context, $Here, @Errors) = ();
    do $file;
    die "error in user file: $@"
	if $@;
    die "can't access user file '$file': $!\n"
	if $!;
    die (map ("$_\n", @Errors))
	if @Errors;
    return ($Self->{domains});
}


sub section {
    $Context = shift
	or die "section type required";
    undef($Here);
    my $Name = shift;
    $Here = $Self->{$Context}->{$Name} = {}
	if $Name;
}


sub policy { section('policies', @_) }


sub handler { section('handlers', @_) }


sub domain { section('domains', @_) }


sub dnsbl_ip {
    my ($id, $domain) = @_;
    $Self->{dnsbl_ip}->{$id} = $domain;
}


sub dnsbl {
    my ($id, $action) = @_;
    _complain("dnsbl declaration outside policies section", caller)
	if not $Context eq 'policies';
    _complain("dnsbl '$id' not previously declared", caller)
	if not exists($Self->{dnsbl_ip}->{$id});
    $Here->{dnsbl_ip}->{$Self->{dnsbl_ip}->{$id}} = $action;
}


sub forward_to {
    my ($address) = @_;
    _complain("forward_to declaration outside handlers section", caller)
	if not $Context eq 'handlers';
    $Here->{forward_to} = []
	if not defined($Here->{forward_to});
    push @{$Here->{forward_to}}, $address;
}


sub user {
    my ($lp, %data) = @_;
    _complain("user declaration outside domains section", caller)
	if not $Context eq 'domains';
    my $user = $Here->{$lp} = {};
    while (my ($k, $v) = each %data) {
	_complain("section '$k' not previously declared", caller), next
	    if not defined($Self->{$k});
	for (ref($v) ? @$v : ($v)) {
	    _complain("'$_' not previously declared in $k", caller)
		if not defined($Self->{$k}->{$_});
	    $user->{$k}->{$_} = $Self->{$k}->{$_};
	}
    }
}


sub _complain {
    my ($gripe, $package, $filename, $line) = @_;
    push @Errors, "$gripe at '$filename' line $line";
}


1;
